 PAG
******************
*    SSIXFONE    *
******************

 ORG $C800

MSGBORDR
 ASC " | M = STK REA WRI LNG BNK PG2 80S CXR  "
 DFB " ","|",38
 DFB " ","|",38
 ASC " | KEY BRK TYP SAV TXT MIX HGR 80C ALT  "
 DFB " ","|",38
 ASC " |---memory-------breakpoints----stack--"
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",7,"<",EOT

MSGBORD2
 DFB " ","|",13
 ASC "|npt----range---|"
 DFB 8
 ASC " |--eff-adrs---|"
 DFB 15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",12,"<","|",15,"|",8
 DFB " ","|",13,"|",15,"|",8
 DFB " ","|",13,"|",15,"|",EOT

********************************
* TABLE1
* THE NUMBERS FROM 0 TO 182,
* ARE OFFSETS TO THE 2 BYTES
* OF THE PACKED MNEMONIC IN THE
* MNEMONIC TABLE. THE OPCODE IS
* THE MATRIX POSITION.
********************************

TABLE1 EQU *

*LSD-->   0 1 2 3 4 5 6 7 8 9 A B C D E F

 HEX 16522852A05204526252045EA0520452
 HEX 125252529E5204521E52369A9E520452
 HEX 420240020C0276026E02766C0C027602
 HEX 0E0202020C02760282022EA20C027602
 HEX 7A34B2344E344A345A344A603E344A34
 HEX 1A3434344C344A34223466983E344A34
 HEX 7E005800920078006800787C3E007800
 HEX 1C000000920078008600729C3E007800
 HEX 148A188A908A8E8A320CA65C908A8E8A
 HEX 068A8A8A908A8E8AAC8AA8AA928A928A
 HEX 48444644484446449644946A48444644
 HEX 08444444484446442444A4AE48444644
 HEX 2C2674262C262E263A2630B02C262E26
 HEX 1026262656262E262026648C3C262E26
 HEX 2A8088802A803680388050B42A803680
 HEX 0A80808054803680848070B642803680

****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

***** LDA TABLE1,X *****

LTABLE1 CMP $C800  ;DISABLE EXT RAM
 LDA TABLE1,X
 CMP $CF00  ;ENABLE EXT RAM
 RTS

***** RDKEY *****
* FLASH PROMPT & READ CHAR

TORDCHAR
 LDA CURSHORZ
 LSR   ;DIVIDE BY 2
 STA MEMHORZ  ;MEM POINTER
 BCS INMAIN  ;ODD COLUMN, MAIN MEM

 BIT OFFFLAG  ;DON'T CHANGE PAGE2 SWITCH
 BMI INMAIN  ;IF OFF

*INPUT FROM AUX MEM

INAUX
 STA TXTPAGE2 ;AUX ON
 LDY MEMHORZ  ;MEM POINTER
 LDA (BASL),Y ;GET EXISTING CHAR
 STA TXTPAGE1 ;MAIN ON
 PHA   ;SAVE EXISTING CHAR
 AND #$A0  ;ALLOW ONLY SPACE
 ORA #$20  ;MAKE SURE ITS SPACE
 EOR #$80  ;INVERT THE SPACE
 JSR WRTAUXIN ;WRITE AUX, DELAY FOR FLASH

* KEYPRESS WILL BE DETECTED WITH NEXT KEYIN
* NORMAL CHAR BACK TO SCREEN

 PLA   ;GET ORIG. CHAR
 LDY MEMHORZ  ;SCREEN MEM POINTER
 JSR WRTAUXIN ;PUT NORMAL CHAR BACK, DO KEYIN
 BMI KEYPRES  ;IF KEY PRESSED
 BEQ INAUX  ;<ALWAYS> KEEP LOOKING

*INPUT FROM MAIN MEM

INMAIN LDY MEMHORZ
 LDA (BASL),Y ;GET EXISTING CHAR
 PHA   ;SAVE
 AND #$A0  ;ALLOW ONLY SPACE
 ORA #$20  ;MAKE SURE ITS SPACE
 EOR #$80  ;INVERT THE SPACE
 STA (BASL),Y
 JSR KEYIN  ;DELAY FOR FLASH RATE

* KEYPRESS DETECTED BY NEXT KEYIN
* NORMAL CHAR BACK

 PLA   ;GET ORIG CHAR
 LDY MEMHORZ  ;SCREEN MEM POINTER
 STA (BASL),Y ;PUT ORIG. CHAR BACK
 JSR KEYIN  ;CHECK FOR KEYPRESS
 BMI KEYPRES
 BEQ INMAIN  ;<ALWAYS> KEEP LOOKING
KEYPRES EQU *

* KEY CLICK

 LDY #10
KEYCLIK LDA #8
 JSR TRANSFR6 ;WAIT
 DFB WAITC  ;code
 LDA SPKR
 DEY
 BNE KEYCLIK
 LDA KBD  ;GET KEYCODE
 BIT KBDSTRB
 RTS

* DISPLAY CHAR TO AUX MEM AND FALL THRU TO KEYIN

WRTAUXIN
 STA TXTPAGE2 ;AUX ON
 STA (BASL),Y ;PUT ON SCREEN
 STA TXTPAGE1 ;MAIN ON

* CHECK FOR A KEYPRESS & DELAY FOR FLASH RATE
* CHECK FOR KEYPRESS MUST BE IN THIS LOOP TO AVOID
* A WAITING FOR END OF FLASH.

KEYIN LDY #00
KEYIN2 LDA #20
 JSR TRANSFR6 ;SMALL DELAY
 DFB WAITC  ;code
 BIT KBD  ;CHECK FOR KEYPRES
 BMI KEYINRTS ;YES KEY PRESSED
 DEY
 BNE KEYIN2  ;NO KEEP LOOKING
KEYINRTS
 RTS

***********************************
* RESTORE THE DISPLAY SWITCHES.
* IF INVISIBL MODE IS SET, EXCHANGE
* THE EXT II TEXT BUFFER WITH TEXT SCREEN
***********************************

RESTTEXT
 BIT RESTFLAG ;HAVE DISPLAY ROUTINES BEEN USED?
 BPL SET80S  ;NO, SO SCREEN IS OK
 LDA #00
 STA RESTFLAG ;CLEAR FLAG
 BIT OFFFLAG  ;IS DISPLAY TURNED OFF?
 BMI SET80S  ;IF OFF THEN SKIP

* RESTORE APPLE'S BASL - BAS2H, CHANGED BY EXT SCREEN OUTPUT
 LDX #3  ;4 BYTES
:NEXT LDA BASBUF,X ;GET FROM EXT BUF
 STA BASL,X  ;PUT IN APPLE'S RAM
 DEX
 BPL :NEXT

 BIT INVISIBL ;CHECK INVISIBLE MODE FLAG
 BPL RESTDISP ;NOT INVISIBLE MODE SO DON'T RESTORE TEXT PAGE
 
 JSR EXCHTEXT ;EXCHANGE TEXT

* RESTORE DISPLAY SWITCHES
* SET THE FOLLOWING SWITCHES: 80COL, ALTCHARSET

RESTDISP

 LDA DISPFLAG ;GET FLAGS
 LDX #$C  ;SWITCH OFFSET
NEXTSW1 LSR   ;SET CARRY WITH BIT 0
 BCS SWCHON1  ;TURN VIDEO SWITCH ON
 STA $C000,X  ;SET SWITCH OFF
 BCC INCSW1  ;<ALWAYS> NEXT SWITCH
SWCHON1 STA $C001,X  ;SWITCH ON
INCSW1 INX
 INX   ;NEXT PAIR OF SWITCHES
 CPX #$10  ;ALL SET?
 BLT NEXTSW1  ;IF NO

*SET THE FOLLOWING SWITCHES: HIRES, PAGE2, MIXED, TEXT

 LDX #$57  ;SWITCH OFFSET
NEXTSW2 LSR   ;SET CARRY WITH BIT0
 BCS SWCHON2  ;TURN SWITCH ON
 STA $C000-1,X ;SWITCH OFF
 BCC DECSW1  ;<ALWAYS> NEXT SWITCH
SWCHON2 STA $C000,X  ;SET SWITCH ON
DECSW1 DEX
 DEX   ;NEXT SWITCH
 CPX #$50  ;ALL SET?
 BGE NEXTSW2  ;IF NO

* SET 80 COL SWITCH ALWAYS BECAUSE ITS CHANGED BY LDA & STA INDY

SET80S BIT DISPFLAG ;SET N BIT
 BMI SWCHON3  ;TURN SWITCH ON
 STA $C000  ;80STORE OFF
 BPL RESTRTS  ;<ALWAYS>
SWCHON3 STA $C001  ;80STORE ON

RESTRTS RTS

************************************
* SAVE THE DISPLAY SWITCHES. IF INVISIBLE
* MODE IS SET, EXCHANGE THE TEXT SCREEN 
* WITH EXT II TEXT BUFFER
***********************************  

ZPAGSAVE

* SAVE APPLE'S BASL - BAS2H, CHANGED BY EXT SCREEN OUTPUT
 LDX #3  ;4 BYTES
:NEXT LDA BASL,X  ;GET FROM APPLE
 STA BASBUF,X ;PUT IN EXT BUFFER
 DEX
 BPL :NEXT

* SAVE THE DISPLAY SWITCHES

*DISPFLAG FORMAT

*BIT7 = 80STORE
*BIT6 = VBL (NO USE)
*BIT5 = TEXT
*BIT4 = MIXED
*BIT3 = PAGE2
*BIT2 = HIRES
*BIT1 = ALTCHARSET
*BIT0 = 80COL

SAVEDISP
 LDA #0
 STA INITFLAG ;CLEAR (USERS PROGRAM RUN) FLAG
 LDX #7  ;SWITCH OFFSET
:SAVE
 LDA $C018,X  ;GET STATUS
 AND #$80  ;STRIP ALL BUT MSB
 LSR DISPFLAG ;MAKE ROOM FOR NEXT FLAG
 ORA DISPFLAG ;MIX WITH OTHER FLAGS
 STA DISPFLAG ;SAVE RESULT
 DEX   ;DEX FLAG COUNTER
 BPL :SAVE  ;MORE FLAGS

 JSR SETMSTAT ;SET MSTATE REGISTER
* SET ACTIVE PERIPHERAL SLOT
 LDA $7F8  ;CURRENT ACTIVE SLOT
 STA ACTVSLOT ;PUT IN I/O SPACE ROUTINE

 BIT INVISIBL ;TEST INVISIBLE MODE
 BPL RESTRTS  ;NOT INV. MODE
 BIT OFFFLAG  ;IS DISPLAY OFF ?
 BMI RESTRTS  ;IF OFF, SKIP EXCHANGE

 JSR EXCHTEXT ;EXCHANGE TEXT WITH EXT BUF

 JMP RESTDISP ;RESTORE DISPLAY SWITCHES & RTS

***** SETMSTAT *****

* MEMORY STATE REGISTER (NOT THE SAME AS EDM ROMS OR IIGS)
* USED AS INDICATOR AND FOR BANKCHEK, SETS TO CURRENT MEMORY
* STATE SO MUST BE RUN BEFORE ANYTHING IS CHANGED.

* M=
* BIT 0=1 IF INTERNAL ROM ON ($C100-$CFFF) CXROM {$C015}
* BIT 1=1 IF 80 STORE ON {$C018}
* BIT 2=1 IF PAGE 2 ON {$C01C}
* BIT 3=1 IF LC BANK 2 IS IN  0= BANK 1 {$C011}
* BIT 4=1 IF LC IS BANKED IN  0= AUTOSTART ROM {$C012}
* BIT 5=1 IF AUX RAM BEING WRITTEN TO ($200-$BFFF) {$C014}
* BIT 6=1 IF AUX RAM BEING READ FROM ($200-$BFFF) {$C013}
* BIT 7=1 IF AUX STACK & ZP & LC ON {$C016}

* XOFFSET			; OFFSETS TO VARIOUS FLAG POSITIONS

XOFFSET
 HEX 05020301000B07

* DETERMINE MSTATE
* SET BIT 0 FROM STORED INFO

SETMSTAT
 BIT CXSTATUS ;IS CXROM ON ?
 CLC
 BPL :CXOFF  ;IF OFF
 SEC
:CXOFF ROR MSTATE  ;SET BIT 0

* SET BIT 1-7 FROM CURRENT SWITCHES

 LDY #6
:SETM LDX XOFFSET,Y
 LDA $C011,X
 CLC
 BPL :NOTSET
 SEC
:NOTSET ROR MSTATE
 DEY
 BPL :SETM
 RTS

***** SETMPBR *****
* DO SETMSTAT AND BANKCHEK

SETMPBR JSR SETMSTAT
 JSR TRANSFR6 ;BANKCHEK
 DFB BANKCHEKC ;code
 RTS   ;ACC = MEMPBR

* SUBROUTINES USED ABOVE

*********************************
* EXCHANGE TEXT RAM AREA WITH EXT RAM
*********************************

EXCHTEXT

* INITIALIZE POINTERS AND RAM

 LDX #$5
:SAVE
 LDA $20,X  ;SAVE Z PAGE
 STA ZPAGEXT,X ;USED WHEN SAVING TEXT RAM
 DEX
 BPL :SAVE

 LDA #0
 STA Z1LO
 LDA #$04
 STA Z1HI  ;$400
 LDA #$11  ;$1-$10 ARE VIA
 STA Z2LO
 LDA #$C8
 STA Z2HI  ;$C810
 LDX SLOTN0
 STX ZBUF5  ;SAVE TO Z PAGE

*********************************
*   W A R N I N G
* SEGMENT DEPENDENT CODE
********************************* 

 LDA #%00100110 ;RAM2, ROM6
 STA SEGMBASE,X
 STA ZBUF6  ;SAVE SEG#
 LDX #00
 LDY #00
 STA STR80ON  ;ENABLE AUX ACCESS
 STA TXTPAGE1 ;SELECT MAIN TEXT RAM

SAVENEXT
 LDA (Z1LO),Y ;GET FROM SCREEN
 PHA
 LDA (Z2LO,X) ;GET FROM EXT RAM
 STA (Z1LO),Y ;PUT ON SCREEN
 PLA   ;GET SCREEN VALUE
 STA (Z2LO,X) ;SAVE TO EXT RAM
 JSR SVTXTINC ;RETURNS WITH CARRY SET WHEN DONE

* EXCHANGE THE AUX MEM PORTION OF 80 COL DISP.

 STA TXTPAGE2 ;SELECT AUX MEM
 LDA (Z1LO),Y ;GET FROM SCREEN
 PHA
 LDA (Z2LO,X) ;GET FROM EXT RAM
 STA (Z1LO),Y ;PUT ON SCREEN
 PLA   ;GET SCREEN VALUE
 STA (Z2LO,X) ;SAVE TO EXT RAM
 STA TXTPAGE1 ;SELECT MAIN MEM
 JSR INCTEXT
 BCC SAVENEXT

* RETURN RAM TO SEG 0

 LDX ZBUF5  ;GET SLOTN0 FROM Z PAGE BUFFER
*********************************
*  W A R N I N G
* THIS IS SEGMENT DEPENDENT CODE
*********************************
 LDA #%00000110 ;RAM0, ROM6
 STA SEGMBASE,X

*** RESTORE Z PAGE LOCATIONS ***

 LDX #$5
:REST
 LDA ZPAGEXT,X
 STA $20,X  ;RESTORE Z PAGE
 DEX
 BPL :REST

 RTS

* INC. SCREEN POINTER

INCTEXT INY
 CPY #$79
 BLT SVTXTINC
 CPY #$80
 BLT INCTEXT
 CPY #$F9
 BLT SVTXTINC
 INC Z1HI
 LDA Z1HI
 CMP #$08
 BGE NEXTTEXT ;CARRY SET
 LDY #0

SVTXTINC
 CLC
 LDA Z2LO
 ADC #1
 STA Z2LO  ;INC EXT RAM POINTER
 LDA Z2HI
 ADC #0
 CMP #$CA
 BLT THISSEG
 LDX ZBUF5  ;GET FROM Z PAGE BUFFER
 LDA ZBUF6  ;GET LAST SEG# USED
 CLC
 ADC #%00010000 ;NEXT RAM SEG
 STA ZBUF6  ;SAVE
 STA SEGMBASE,X
 LDX #0  ;RESET
 LDA #$11  ; $C801 - $C810 ARE VIA
 STA Z2LO
 LDA #$C8
THISSEG STA Z2HI
 CLC
NEXTTEXT
 RTS

*********************************
* INITIALIZE EXT RAM
*********************************

INITRAMV
 LDA #0
 STA PBR  ;DEFAULT TO BANK 0
 LDA #>MONITOR ; -SET UP PCHI & PCLO
 STA PCHI  ; - TO RETURN TO MONITOR IF GO COMMAND IS
 STA MEMHI  ; FOR BANKCHEK
 LDA #MONITOR ; - GIVEN WITHOUT CHANGING THE PROGRAM COUNTER
 STA PCLO  ; - AFTER ENTERING AT START1.

 LDA SLOTCN
 STA RESETHI  ;HI BYTE OF RESET VECTOR
 LDA #RESETJMP ;LOW BYTE OF RESET VECTOR
 STA RESETLO  ;PUT IN EXT RAM
 LDA #$FF  ;HI BYTE OF ROUTINES THAT REPLACE APPLE'S ROMS
 STA IRQHI  ;HI BYTE OF 6502 IRQ VECTOR
 STA NMIHI  ;HI BYTE OF 6502 NMI VECTOR
 STA NMIHI816 ;HI BYTE OF 65816 NMI VECTOR
 STA BRKHI816 ;HI BYTE OF 65816 BRK VECTOR
 LDA #IRQRAM8 ;LOW BYTE OF IRQ VECTOR
 STA IRQLO  ;PUT IN EXT RAM
 LDA #NMIRAM8 ;LOW BYTE
 STA NMILO  ;PUT IN EXT RAM
 LDA #NMIRAM16
 STA NMILO816 ;LOW BYTE OF 65816 NMI VECTOR
 LDA #BRKRAM16
 STA BRKLO816 ;LOW BYTE OF 65816 BRK VECTOR

*WAS CARD SELECTED BY PR#N OR IN#N

 LDA SLOTCN  ;GET SLOT NUMBER CN
 CMP CSWH  ;WAS PR#N USED ?
 BNE CHKKSW  ;IF NO
 LDA #COUT1APL ;LOW ADDRESS BYTE
 STA CSWL  ;PUT COUT1 ADDRESS IN
 LDA #>COUT1APL
 STA CSWH
CHKKSW LDA SLOTCN  ;GET SLOT NUMBER CN
 CMP KSWH  ;WAS IN#N USED
 BNE SETUP  ;IF NO
 LDA #KEYIN  ;PUT KEYIN ADDRESS IN
 STA KSWL
 LDA #>KEYIN
 STA KSWH

* SET DISPLAY MODE

SETUP
 LDX #POINT-TCOUNT ;CLEAR EXT RAM FROM TCOUNT TO POINT
 LDA #00
 STA IOMODE  ;SET TO SCREEN I/O
 STA OFFFLAG  ;DISPLAY ON
:CLREXT STA TCOUNT,X
 DEX
 BPL :CLREXT
 LDA #$80  ;DEFAULT SETUP
 STA INVISIBL ;SO TEXT RAM IS SAVED DURING INITIALIZATION
 STA CMOSFLAG ;SET 65C02
 STA EMULATE  ;SET 65C02 DEFAULT
 LDA #CTRLS
 STA KEY  ;SET STOP KEY TO CTRL-S

* INITIALIZE VIA

 LDA #%01111111 ;DISABLE INTERRUPTS
 STA VIAIER
 LDA #$FF
 STA VIADRA  ;MAKE ALL A LINES OUTPUTS
 STA VIADRB  ;" " " B " "
 LDA #0
 STA VIAACR  ;SET UP TIMERS
 LDA #%11111110 ;DON'T REPLACE APPLE'S VECTORS WHILE IN EXTERM
 STA VIAPCR  ;SET UP CA1,CA2,CB1
 LDA #%10000010
 STA IERBUFF  ;INTERRUPTS TO ENABLE

* MOVE INTERRUPT, CXROM ROUTINES TO EXTERM RAM

 JSR TRANSFR6
 DFB ROMTORAMC ;code

* WARM ENTRY COMES HERE

WARMINIT
 JSR ZPAGSAVE ;SAVE DISPLAY SWITCHES
 JSR SETMPBR  ;SET MSTATE & PBR
 JSR TRANSFR6 ;TURN DISPLAY ON
 DFB DISPONC  ;code
 JSR TRANSFR6 ;display copyright
 DFB COPYRC  ;code

 RTS

***** DISPLAY WINDOW BORDERS *****

DSPBORDR

* DON'T DISPLAY IF NOT SCREEN I/O

 LDA IOMODE
 BNE :END

* SET FULL SCREEN WINDOW WITH LEFT EDGE IN COL 42

 LDA #0
 STA WINDTOP
 LDA #40
 STA WINDLEFT
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR TRANSFR6 ;HOME
 DFB HOMEC  ;code

* DISPLAY BORDERS

 JSR WRINIT6
:MORE LDA MSGBORDR,Y ;GET CHAR
 JSR WRITECK6 ;DISPLAY
 BCC :MORE

 JSR WRINIT6
:LOOP LDA MSGBORD2,Y ;GET CHAR
 JSR WRITECK6 ;DISPLAY
 BCC :LOOP

 JSR TRANSFR6 ;CLEAR LOWER RIGHT CORNER
 DFB CLREOLC  ;code

:END RTS

****************************************
* MUST BE BEFORE $CF00
****************************************

* DISPLAY ASCII TEXT
* POSITIVE NUMBERS IN MESSAGE ARE NUMBER OF SPACES

WRINIT6 STY YBUFF  ;SAVE
 LDY #0
WRITMOR6
 CMP $C800  ;DISABLE EXTRAM
 CLC   ;NOT FINISHED FLAG
 RTS

WRITECK6
 CMP $CF00  ;ENABLE RAM
 INY   ;INCREMENT POINTER
 CMP #EOT  ;IS IT EOT
 BEQ :DONE  ;IF YES WRITE IS DONE
 AND #$FF  ;SET FLAGS
 BMI :NOSPCE  ;IF MSB HI
 TAX
 JSR TRANSFR6 ;PRINT SPACES
 DFB PRBL2C  ;code
 JMP WRITMOR6
:NOSPCE JSR TRANSFR6 ;DISPLAY ON OUTPUT DEVICE
 DFB COUTC  ;code
 JMP WRITMOR6 ;WRITE MORE CHARACTERS
:DONE
 SEC
 RTS

******************************
*RESTORE 16 BYTES THAT WERE SAVED FROM ALTERNATE STACK
* TO EXT RAM STACK BUFFER BECAUSE THE USERS PROGRAM
* HAS JUST SWITCHED STACKS.

RESTALTS
 LDX STACK
 LDY #15
:NEXT LDA STKBUF,Y ;GET FROM EXT RAM
 PHA   ;PUT IN STACK
 DEX   ;KEEP IN SYNC WITH STACK
 DEY
 BPL :NEXT

 LDY SLOTN0
**********************************
* WARNING, SEGMENT DEPENDENT CODE 		
**********************************
 LDA #%01110110 ;RAM 7, ROM 6
 STA SEGMBASE,Y
 STY YREG  ;SAVE IN THIS SEG

 LDY #15
:LOOP PLA   ;GET FROM USER STACK
 INX
 STA STACKBUF,X ;PUT IN EXT BUFFER
 DEY
 BPL :LOOP

 LDY YREG  ;SLOTN0
***********************************
* WARNING, SEGMENT DEPENDENT CODE
***********************************
 LDA #%00000110 ;RAM 0, ROM 6
 STA SEGMBASE,Y
 RTS

*-------------------------------------------------
* Pascal 1.1 interface routines
* X & Y preserved

* Initialize pascal slot
INITPASC LDA #$0D ;low address byte of Pascal 1.1 init offset
 BNE GOPASCAL

* Wait for and get next character
INPASCAL LDA #$0E ;low address byte of Pascal 1.1 read offset
 BNE GOPASCAL

* Get port status, X not saved
STATPASC TAX  ;save request code
 LDA #$10 ;low address byte of Pascal 1.1 status offset
*-------------------------------------------------
* Call the Pascal I/O interface routine. Must use TRANSFRx so we return
* to proper segment.

GOPASCAL STA ASAVESEG ;save Acc
 TXA
 PHA  ;save X
 TYA
 PHA  ;save Y
 LDA ASAVESEG ;restore Acc
 JSR TRANSFR6 ;go to pascal 1.1 routine
 DFB PASCALIOC ;code
 PLA
 TAY  ;restore Y
 PLA
 TAX ;restore X
 LDA ASAVESEG ;saved during segment transfer
 ORA #$80 ;strip parity if receiving
 RTS

* Send a character out pascal slot
OUTPASCL 
 PHA  ;save Acc
 STA ASAVESEG ;save Acc
 TXA
 PHA  ;save X
 LDA ASAVESEG ;restore Acc
:LFEED AND #$7F ;STRIP PARITY
 PHA  ;save char to write
:TXFULL LDA #$0 ;request code, 'are you ready for output?'
 JSR STATPASC ;get serial I/O status
 BCC :TXFULL
 PLA  ;char to write
 PHA
 TAX  ;set X
 LDA #$0F ;low address byte of Pascal 1.1 write offset
 JSR GOPASCAL ;send character
 PLA  ;character wrote
 CMP #CR&$7F ;CARRIAGE RETURN?
 BNE :EXIT ;NO
 JSR TRANSFR6 ;DELAY FOR CR
 DFB WAITC ;code
 LDA #LF
 BNE :LFEED ;DO LINE FEED
:EXIT PLA
 TAX  ;restore X
 PLA  ;restore Acc
 RTS


******* SAVE THE ACC, X AND P REGISTERS *****

SAVEAXP6
 PHP   ;SAVE STATUS
 STX XSAVESEG
 STA ASAVESEG
 PLA   ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

****** RESTORE THE ACC, X AND P REGISTERS *****

RESTAXP6
 LDX XSAVESEG
 LDA PSAVESEG
 PHA
 LDA ASAVESEG
 PLP
 RTS

***** THIS SEGMENTS GLOBAL SUBROUTINES *****

SUBTABL6

LTABLE1C EQU *-SUBTABL6*4+6+$100
 DA LTABLE1-1

TORDCHARC EQU *-SUBTABL6*4+6+$100
 DA TORDCHAR-1

RESTTEXTC EQU *-SUBTABL6*4+6+$100
 DA RESTTEXT-1

RESTDISPC EQU *-SUBTABL6*4+6+$100
 DA RESTDISP-1

ZPAGSAVEC EQU *-SUBTABL6*4+6+$100
 DA ZPAGSAVE-1

SAVEDISPC EQU *-SUBTABL6*4+6+$100
 DA SAVEDISP-1

INITRAMVC EQU *-SUBTABL6*4+6+$100
 DA INITRAMV-1

SETMSTATC EQU *-SUBTABL6*4+6+$100
 DA SETMSTAT-1

SETMPBRC EQU *-SUBTABL6*4+6+$100
 DA SETMPBR-1

DSPBORDRC EQU *-SUBTABL6*4+6+$100
 DA DSPBORDR-1

RESTALTSC EQU *-SUBTABL6*4+6+$100
 DA RESTALTS-1

INITPASCC EQU *-SUBTABL6*4+6+$100
 DA INITPASC-1

INPASCALC EQU *-SUBTABL6*4+6+$100
 DA INPASCAL-1

STATPASCC EQU *-SUBTABL6*4+6+$100
 DA STATPASC-1

OUTPASCLC EQU *-SUBTABL6*4+6+$100
 DA OUTPASCL-1

WARMINITC EQU *-SUBTABL6*4+6+$100
 DA WARMINIT-1

*********************************
**** SEGMENT CROSSOVER AREA *****
*********************************

 LST ON
S6END = $CF9D-*
 do nolist
 LST OFF
 fin
 ERR *-1/$CF9D
 DS $CF9D-*,$FF

MAIN106 JSR SAVEAXP6 ;COME HERE TO TRANSFER TO SEGMENT0 DIRECTLY
 LDX SLOTN0
 LDA #%00000101 ;RAM0,ROM5
 STA SEGMBASE,X ;NEXT INSTRUCTION EXECUTED FROM SEGMENT 5
 JSR RESTAXP6 ;RESTORE AFTER TRANSFER FROM SEGMENT 5
 RTS   ;GOTO COMMANDS IN THIS SEGMENT
 NOP
 NOP   ;MATCH LENGTH WITH SEG 5

* TRANSFER TO OTHER SEGMENTS

TRANSFR6

 JSR SAVEAXP6
 PLA   ;GET RETRUN ADDRESS FROM STACK
 CLC
 ADC #1  ;INC TO POINT AT CODE BYTE
 STA TEMPSEG  ;SETUP LDA TEMPSEG ROUTINE
 PLA
 ADC #0  ;ADD CARRY, IF ANY
 STA TEMPSEG+1 ;SETUP LDA TEMPSEG ROUTINE
 PHA
 LDA TEMPSEG
 PHA   ;BUMP RETURN ADDRESS PAST CODE BYTE
 LDA #6  ;CURRENT SEG #
 PHA
 JSR LDATEMP  ;LOAD CODE BYTE
 STA SEGMCODE ;SAVE CODE
 AND #$07  ;STRIP ALL BUT SEG #
 LDX SLOTN0
 STA SEGMBASE,X ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 LDA #>RETURN6 ;WHERE TO RETURN TO
 PHA
 LDA #RETURN6
 PHA
 LDA SEGMCODE ;CODE BYTE
 AND #$F8  ;STIP OFF SEG# LEAVING SUB #
 LSR
 LSR   ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAX
 LDA SUBTABL6+1,X
 PHA
 LDA SUBTABL6,X
 PHA

 JSR RESTAXP6 ;RESTORE REGISTERS
 RTS   ;USE RTS TO GOTO SUB

* RETURN HERE FROM SUBROUTINE

RETURN6 EQU *-1
 JSR SAVEAXP6
 PLA   ;SEG # TO RETURN TO
 LDX SLOTN0
 STA SEGMBASE,X ;RETURN TO SEGMENT
 JSR RESTAXP6
 RTS   ;RETURN TO PROGRAM

 DS \,$FF ;PUT OBJECT AT NEXT PAGE
